﻿Option Explicit On
Option Strict On
Option Infer On

Imports System
Imports System.Collections.Generic
Imports GenDotNet.Task.Common

Public Class VBToCSharp
   Implements IAdjustTemplate

   Private codeStart As String
   Private codeEnd As String
   Private Const expressionStart As String = "<%="
   Private Const expressionEnd As String = "%>"


   Private mLogVerboseDelegate As LogMessageDelegate
   Private mLogMessageDelegate As LogMessageDelegate
   Private mLogWarningDelegate As LogMessageDelegate
   Private mLogErrorDelegate As LogMessageDelegate

   Public Sub logVerbose(ByVal message As String)
      If mLogVerboseDelegate Is Nothing Then
         ' TODO: Consider reaction - console or trace?
      Else
         mLogVerboseDelegate(message)
      End If
   End Sub

   Public Sub logMessage(ByVal message As String)
      If mLogVerboseDelegate Is Nothing Then
         ' TODO: Consider reaction - console or trace?
      Else
         mLogVerboseDelegate(message)
      End If
   End Sub

   Public Sub logWarning(ByVal message As String)
      If mLogVerboseDelegate Is Nothing Then
         ' TODO: Consider reaction - console or trace?
      Else
         mLogVerboseDelegate(message)
      End If
   End Sub

   Public Sub logError(ByVal message As String)
      If mLogVerboseDelegate Is Nothing Then
         ' TODO: Consider reaction - console or trace?
      Else
         mLogVerboseDelegate(message)
      End If
   End Sub

   Public Function Translate( _
            ByVal fileName As String, _
            ByVal codeStart As String, _
            ByVal codeEnd As String, _
            ByVal logVerboseDelegate As LogMessageDelegate, _
            ByVal logMessageDelegate As LogMessageDelegate, _
            ByVal logWarningDelegate As LogMessageDelegate, _
            ByVal logErrorDelegate As LogMessageDelegate) _
            As IEnumerable(Of String) Implements IAdjustTemplate.Translate
      Dim lines As IEnumerable(Of String) = Nothing
      Try
         lines = IO.File.ReadAllLines(fileName)
      Catch ex As Exception
         ' TODO: Log issue and continue
      End Try
      Return Translate(lines, codeStart, codeEnd, logVerboseDelegate, logMessageDelegate, logWarningDelegate, logErrorDelegate)
   End Function

   Public Function Translate( _
            ByVal lines As IEnumerable(Of String), _
            ByVal codeStart As String, _
            ByVal codeEnd As String, _
            ByVal logVerboseDelegate As LogMessageDelegate, _
            ByVal logMessageDelegate As LogMessageDelegate, _
            ByVal logWarningDelegate As LogMessageDelegate, _
            ByVal logErrorDelegate As LogMessageDelegate) _
            As IEnumerable(Of String) Implements IAdjustTemplate.Translate
      If String.Equals(codeStart, codeEnd) Then
         ' TODO: Log Issue and abort  
      End If
      If String.IsNullOrEmpty(codeStart) Or String.IsNullOrEmpty(codeEnd) Then
         ' TODO: Log Issue and abort  
      End If
      Me.codeStart = codeStart
      Me.codeEnd = codeEnd
      Dim lineList = New List(Of String)(lines)
      Dim ret = TranslateExpression(lineList, lines(0), String.Empty, 0, True)
      Return ret
   End Function

   'Private Function Translate( _
   '         ByVal lines As List(Of String), _
   '         ByVal line As String, _
   '         ByRef lineAfter As String, _
   '         ByRef linePos As Int32, _
   '         ByVal doContinue As Boolean) _
   '         As List(Of String)
   '   Dim ret As New List(Of String)
   '   Dim isAtEnd As Boolean
   '   Do While True
   '      Dim contentPart = If(line.Contains("'"), line.SubstringBefore("'"), line)
   '      Dim endPos = contentPart.IndexOf(codeEnd)
   '      Dim startPos = contentPart.IndexOf(codeStart)
   '      If endPos > -1 And (startPos = -1 Or endPos < startPos) Then
   '         ' End on this line
   '         ret.Add(line.SubstringBefore(codeEnd))
   '         lineAfter = line.SubstringAfter(codeEnd)
   '         ret = TranslateCode(ret)
   '         isAtEnd = True
   '         Exit Do
   '      ElseIf startPos > -1 And (endPos = -1 Or startPos < endPos) Then
   '         ' start on this line
   '         EvaluateBlock(ret, lines, line, lineAfter, linePos)
   '      ElseIf startPos = -1 And endPos = -1 Then
   '         ' just a continuation line
   '         ret.Add(line)
   '      Else
   '         Console.WriteLine("unexpected Condition")
   '         ' Is there anything else
   '      End If
   '      If (Not isAtEnd) And doContinue Then
   '         linePos += 1
   '         If linePos >= lines.Count Then
   '            Exit Do
   '            'This represents an error in the code block matching that should not have survived the 
   '            'first compilation, or a bug in our own code
   '         End If
   '         line = lines(linePos)
   '      Else
   '         Exit Do
   '      End If
   '   Loop
   '   Return ret
   'End Function

   'Private Sub EvaluateBlock(ByVal ret As List(Of String), _
   '                          ByVal lines As List(Of String), _
   '                          ByVal line As String, _
   '                          ByRef lineAfter As String, _
   '                          ByRef linePos As Int32)
   '   Dim lineBefore = line.SubstringBefore(codeStart)
   '   Dim after = String.Empty
   '   Dim codeLines = Translate(lines, line.SubstringAfter(codeStart), after, linePos, True)
   '   If codeLines.Count = 1 Then
   '      ret.Add(lineBefore & "<code1>" & codeLines(0) & "</code1>" & after)
   '   Else
   '      ret.Add(lineBefore & "<code1>" & codeLines(0))
   '      ret.AddRange(From codeline In codeLines Skip 1 Take codeLines.Count - 2)
   '      ret.Add(codeLines(codeLines.Count - 1) & "</code1>" & after)
   '   End If
   '   If after.Contains(codeStart) Then
   '      Dim codeLinesInner = Translate(lines, after.Substring(0), after, linePos, False)
   '      codeLines(codeLines.Count - 1) &= codeLinesInner(0)
   '      For i = 1 To codeLinesInner.Count - 1
   '         codeLines.Add(codeLinesInner(i))
   '      Next
   '   End If
   '   lineAfter = after

   'End Sub

   Private Function TranslateExpression( _
            ByVal lines As List(Of String), _
            ByVal line As String, _
            ByRef lineAfter As String, _
            ByRef linePos As Int32, _
            ByVal doContinue As Boolean) _
            As List(Of String)
      Dim ret As New List(Of String)
      Dim isAtEnd As Boolean
      Dim after As String = String.Empty
      Dim handlingLineAfter As Boolean
      Do While True
         Dim contentPart = If(line.Contains("'"), line.SubstringBefore("'"), line)
         Dim first = FindFirst(contentPart, codeStart, codeEnd, expressionStart, expressionEnd)
         If String.IsNullOrEmpty(first) Then
            ' just a continuing line
            ret.Add(line)
         ElseIf first = codeEnd Then
            logError("Improperly matched Code construct at line" & linePos.ToString)
            Return Nothing
         ElseIf first = codeStart Then
            ' start on this line
            EvaluateCodeBlock(ret, lines, line, after, linePos)
         ElseIf first = expressionEnd Then
            ret.Add(line.SubstringBefore(expressionEnd))
            If handlingLineAfter Then
               ret(ret.Count - 1) &= line.SubstringBefore(expressionEnd)
            Else
               ret.Add(line.SubstringBefore(expressionEnd))
            End If
            lineAfter = line.SubstringAfter(expressionEnd)
            isAtEnd = True
            Exit Do
         ElseIf first = expressionStart Then
            logError("Improperly matched Code construct at line" & linePos.ToString)
            Return Nothing
         Else
            Console.WriteLine("unexpected Condition")
            ' Is there anything else
         End If
         If Not String.IsNullOrEmpty(after) Then
            handlingLineAfter = True
            line = after
            after = String.Empty
            ' Linepos is unchanged
         ElseIf (Not isAtEnd) And doContinue Then
            handlingLineAfter = True
            linePos += 1
            If linePos >= lines.Count Then
               Exit Do
               'This represents an error in the code block matching that should not have survived the 
               'first compilation, or a bug in our own code
            End If
            line = lines(linePos)
         Else
            Exit Do
         End If
      Loop
      Return ret
   End Function

   Private Function Translatecode( _
         ByVal lines As List(Of String), _
         ByVal line As String, _
         ByRef lineAfter As String, _
         ByRef linePos As Int32, _
         ByVal doContinue As Boolean) _
         As List(Of String)
      Dim ret As New List(Of String)
      Dim isAtEnd As Boolean
      Dim after = String.Empty
      Dim handlingLineAfter = False
      Do While True
         Dim contentPart = If(line.Contains("'"), line.SubstringBefore("'"), line)
         Dim first = FindFirst(contentPart, codeStart, codeEnd, expressionStart, expressionEnd)
         If String.IsNullOrEmpty(first) Then
            ' just a continuing line
            ret.Add(line)
         ElseIf first = codeEnd Then
            ' End on this line
            If handlingLineAfter Then
               ret(ret.Count - 1) &= line.SubstringBefore(codeEnd)
            Else
               ret.Add(line.SubstringBefore(codeEnd))
            End If
            lineAfter = line.SubstringAfter(codeEnd)
            ret = TranslateCode(ret)
            isAtEnd = True
            Exit Do
         ElseIf first = codeStart Then
            logError("Improperly matched Code construct at line" & linePos.ToString)
            Return Nothing
         ElseIf first = expressionEnd Then
            logError("Improperly matched Code construct at line" & linePos.ToString)
            Return Nothing
         ElseIf first = expressionStart Then
            EvaluateExpressionBlock(ret, lines, line, lineAfter, linePos)
         Else
            Console.WriteLine("unexpected Condition")
            ' Is there anything else
         End If
         If Not String.IsNullOrEmpty(after) Then
            handlingLineAfter = True
            line = after
            after = String.Empty
            ' Linepos is unchanged
         ElseIf (Not isAtEnd) And doContinue Then
            handlingLineAfter = False
            linePos += 1
            If linePos >= lines.Count Then
               Exit Do
               'This represents an error in the code block matching that should not have survived the 
               'first compilation, or a bug in our own code
            End If
            line = lines(linePos)
         Else
            Exit Do
         End If
      Loop
      Return ret
   End Function

   Private Function FindFirst(ByVal line As String, ByVal ParamArray tokens() As String) As String
      Dim pos(tokens.GetUpperBound(0)) As Int32
      For i = 0 To tokens.GetUpperBound(0)
         pos(i) = line.IndexOf(tokens(i))
      Next
      Dim min As Int32 = -1
      Dim minValue As Int32 = -1
      For i = 0 To tokens.GetUpperBound(0)
         If pos(i) > -1 AndAlso (pos(i) < minValue Or minValue = -1) Then
            minValue = pos(i)
            min = i
         End If
      Next
      If min > -1 Then
         Return tokens(min)
      End If
      Return Nothing
   End Function

   Private Sub EvaluateExpressionBlock(ByVal ret As List(Of String), _
                             ByVal lines As List(Of String), _
                             ByVal line As String, _
                             ByRef lineAfter As String, _
                             ByRef linePos As Int32)
      Dim lineBefore = line.SubstringBefore(expressionStart)
      Dim after = String.Empty
      Dim codeLines = TranslateExpression(lines, line.SubstringAfter(expressionStart), after, linePos, True)
      If codeLines.Count = 1 Then
         ret.Add(lineBefore & expressionStart & codeLines(0) & expressionEnd)
      Else
         ret.Add(lineBefore & expressionStart & codeLines(0))
         ret.AddRange(From codeline In codeLines Skip 1 Take codeLines.Count - 2)
         ret.Add(codeLines(codeLines.Count - 1) & expressionEnd)
      End If
      'Do While after.Length > 0
      '   codeLines = Translatecode(lines, after.Substring(0), after, linePos, False)
      '   ret(ret.Count - 1) &= codeLines(0)
      '   For i = 1 To codeLines.Count - 1
      '      ret.Add(codeLines(i))
      '   Next
      'Loop
      ''If after.Contains(startMarker) Then
      ''   Dim codeLinesInner = Translatecode(lines, after.Substring(0), after, linePos, False)
      ''   ret(ret.Count - 1) &= codeLinesInner(0)
      ''   For i = 1 To codeLinesInner.Count - 1
      ''      ret.Add(ret(i))
      ''   Next
      ''End If
      lineAfter = after

   End Sub

   Private Sub EvaluateCodeBlock(ByVal ret As List(Of String), _
                          ByVal lines As List(Of String), _
                          ByVal line As String, _
                          ByRef lineAfter As String, _
                          ByRef linePos As Int32)
      Dim newStartMarker = "<code>"
      Dim newEndMarker = "</code1>"
      Dim lineBefore = line.SubstringBefore(codeStart)
      Dim after = line
      Dim codeLines = Translatecode(lines, line.SubstringAfter(codeStart), after, linePos, True)
      If codeLines.Count = 1 Then
         ret.Add(lineBefore & newStartMarker & codeLines(0) & newEndMarker)
      Else
         ret.Add(lineBefore & newStartMarker & codeLines(0))
         ret.AddRange(From codeline In codeLines Skip 1 Take codeLines.Count - 2)
         ret.Add(codeLines(codeLines.Count - 1) & newEndMarker)
      End If
      'Do While after.Length > 0
      '   codeLines = TranslateExpression(lines, after.Substring(0), after, linePos, False)
      '   ret(ret.Count - 1) &= codeLines(0)
      '   For i = 1 To codeLines.Count - 1
      '      ret.Add(codeLines(i))
      '   Next
      'Loop
      ''If after.Contains(startMarker) Then
      ''   Dim codeLinesInner = TranslateExpression(lines, after.Substring(0), after, linePos, False)
      ''   codeLines(codeLines.Count - 1) &= codeLinesInner(0)
      ''   For i = 1 To codeLinesInner.Count - 1
      ''      codeLines.Add(codeLinesInner(i))
      ''   Next
      ''End If
      lineAfter = after

   End Sub


   'Private Sub EvaluateBlock(ByVal ret As List(Of String), _
   '                         ByVal lines As List(Of String), _
   '                         ByVal line As String, _
   '                         ByRef lineAfter As String, _
   '                         ByRef linePos As Int32)
   '   Dim lineBefore = line.SubstringBefore(codeStart)
   '   Dim after = String.Empty
   '   Dim codeLines = Translate(lines, line.SubstringAfter(codeStart), after, linePos, True)
   '   If codeLines.Count = 1 Then
   '      ret.Add(lineBefore & "<code1>" & codeLines(0) & "</code1>" & after)
   '   Else
   '      ret.Add(lineBefore & "<code1>" & codeLines(0))
   '      ret.AddRange(From codeline In codeLines Skip 1 Take codeLines.Count - 2)
   '      ret.Add(codeLines(codeLines.Count - 1) & "</code1>" & after)
   '   End If
   '   If after.Contains(codeStart) Then
   '      Dim codeLinesInner = Translate(lines, after.Substring(0), after, linePos, False)
   '      codeLines(codeLines.Count - 1) &= codeLinesInner(0)
   '      For i = 1 To codeLinesInner.Count - 1
   '         codeLines.Add(codeLinesInner(i))
   '      Next
   '   End If
   '   lineAfter = after

   'End Sub

   Private Function TranslateCode(ByVal lines As List(Of String)) As List(Of String)
      Dim ret = New List(Of String)
      Dim linePos = 0
      Do While True
         If linePos >= lines.Count Then
            Exit Do
         End If
         ' Action is performed in these Fix methods
         If FixBlockStart(ret, lines, linePos, "If", "if") Then
         ElseIf FixBlockStart(ret, lines, linePos, "For Next", "fornext") Then
         ElseIf FixBlockEnd(ret, lines, linePos) Then
         Else
            ret.Add(FixCase(lines(linePos)))
            linePos += 1
         End If
      Loop
      For Each line In ret
         line = line.Replace("'", "//").Replace(" _", "")
      Next
      Return ret
   End Function

   Private Function FixBlockStart( _
            ByVal ret As List(Of String), _
            ByVal lines As List(Of String), _
            ByRef linePos As Int32, _
            ByVal oldBlockString As String, _
            ByVal newBlockString As String) _
            As Boolean
      ' This will not catch if there are two adjacent embedded expression (including for now a <nws>) with a line split
      If lines(linePos).Trim.StartsWith(oldBlockString) Then
         Dim logicalLine = GetLogicalLine(lines, linePos)
         If oldBlockString = "If" And logicalLine.Last.Trim.EndsWith(" Then") Then
            ' This is imperfect, but should be close enough
            logicalLine(logicalLine.Count - 1) = logicalLine(logicalLine.Count - 1).Replace(" Then", "")
         End If
         logicalLine = FixExpression(logicalLine)
         Dim start = logicalLine(0).SubstringBefore(oldBlockString)
         Dim main = logicalLine(0).SubstringAfter(oldBlockString)
         logicalLine(0) = start & newBlockString & " ( " & main.TrimStart
         logicalLine(logicalLine.Count - 1) = logicalLine(logicalLine.Count - 1).TrimEnd & " )"
         For Each line In logicalLine
            ret.Add(line)
         Next
         ret.Add("{")
         linePos += 1
         Return True
      End If
      Return False
   End Function

   Private Function FixBlockEnd( _
            ByVal ret As List(Of String), _
            ByVal lines As IEnumerable(Of String), _
            ByRef linePos As Int32) _
            As Boolean
      Dim line = lines(linePos)
      Dim contentPortion = line.ContentPortion()
      Dim comment = line.CommentPortion()
      If (New String() {"End If", "Next"}).Contains(contentPortion.Trim) Then
         ret.Add("}" & If(String.IsNullOrEmpty(comment), String.Empty, "  //" & comment))
         linePos += 1
         Return True
      End If
   End Function

   Private Function GetLogicalLine(ByVal lines As List(Of String), ByRef linePos As Int32) As List(Of String)
      Dim ret = New List(Of String)
      For i = linePos To lines.Count - 1
         If lines(linePos).Trim.EndsWith(" _") Then
            ret.Add(lines(i))
            linePos += 1
         Else
            Exit For
         End If
      Next
      ret.Add(lines(linePos))
      Return ret
   End Function

   Private Function FixExpression(ByVal expression As String) As String
      ' I should probably change this to RegEx
      Dim replaceAt = New List(Of Int32)()
      Dim ret = expression
      For i = 0 To ret.Length - 1
         If ret(i) = "=" And (i < 2 OrElse ret(i - 2) <> "<"c OrElse ret(i - 1) <> "%"c) Then
            replaceAt.Add(i)
         End If
      Next
      ret = ret.Replace("<>", "!="). _
               Replace(" Not ", " ! "). _
               Replace(" Is ", " == "). _
               Replace(" IsNot ", " != "). _
               Replace(" Nothing", " null"). _
               Replace("!==", "!="). _
               Replace(" And ", " & "). _
               Replace(" Or ", " | "). _
               Replace(" AndAlso ", " && "). _
               Replace(" OrElse ", " || ")
      For i = replaceAt.Count - 1 To 0 Step -1
         ret = ret.Substring(0, replaceAt(i)) & "=" & ret.Substring(replaceAt(i))
      Next
      Return ret
   End Function

   Private Function FixExpression(ByVal lines As List(Of String)) As List(Of String)
      For i = 0 To lines.Count - 1
         lines(i) = FixExpression(lines(i))
      Next
      Return lines
   End Function

   Private Function FixCase(ByVal line As String) As String
      ' This is not precise and will replace parts of words
      Return line.Replace(" Return", " return").Replace("New(", "new(").Replace("New ", "new ")
   End Function

End Class
